home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_l.arc / PROCS.ARC / ximage.icn < prev   
Encoding:
Text File  |  1990-03-05  |  4.0 KB  |  144 lines
  1. ############################################################################
  2. #
  3. #    Name:    ximage.icn
  4. #
  5. #    Title:    Produces "executable" image of structured data
  6. #
  7. #    Author:    Robert J. Alexander
  8. #
  9. #    Date:    December 5, 1989
  10. #
  11. ############################################################################
  12. #
  13. #  ximage() -- enhanced image()-type procedure that outputs all data
  14. #  contained in structured types.  It is called as follows:
  15. #
  16. #       ximage(x)
  17. #
  18. #  just like image(x) (the other arguments in the "procedure"
  19. #  declaration are used for passing data among recursive levels).  The
  20. #  output has an "executable" appearance, which will look familiar to
  21. #  any Icon programmer.  The returned string for complex data contains
  22. #  newline characters and indentation, suitable for write()-ing,
  23. #  providing a pleasing and useful visual representation of the
  24. #  structures.
  25. #
  26. ############################################################################
  27.  
  28. procedure ximage(x,indent,done)
  29.    local i,s,ss,state,t,xtag
  30.    static tag,tr
  31.    #
  32.    #  If this is the outer invocation, do some initialization.
  33.    #
  34.    if /(state := done) then {
  35.       tr := &trace ; &trace := 0    # postpone tracing while in here
  36.       indent := ""
  37.       tag := 0
  38.       done := table()
  39.       }
  40.    #
  41.    #  Determine the type and process accordingly.
  42.    #
  43.    indent := (if indent == "" then "\n" else "") || indent || "   "
  44.    ss := ""
  45.    t := type(x)
  46.    s := if xtag := \done[x] then xtag else case t of {
  47.       #
  48.       #  Unstructured types just return their image().
  49.       #
  50.       "null" | "string" | "integer" | "real" | "cset" |
  51.         "co-expression" | "file" | "procedure" | "external": image(x)
  52.       #
  53.       #  List.
  54.       #
  55.       "list": {
  56.      done[x] := xtag := "L" || (tag +:= 1)
  57.      #
  58.      #  Figure out if there is a predominance of any object in the
  59.      #  list.  If so, make it the default object.
  60.      #
  61.      t := table(0)
  62.      every t[!x] +:= 1
  63.      s := [,0]
  64.      every t := !sort(t) do if s[2] < t[2] then s := t
  65.      if s[2] > *x / 3 & s[2] > 2 then {
  66.         s := s[1]
  67.         t := ximage(s,indent || "   ",done)
  68.         if t ? (not any('\'"') & ss := tab(find(" :="))) then
  69.           t := "{" || t || indent || "   " || ss || "}"
  70.         }
  71.      else t := &null
  72.      #
  73.      #  Output the non-defaulted elements of the list.
  74.      #
  75.      ss := ""
  76.      every i := 1 to *x do if x[i] ~=== s then {
  77.         ss ||:= indent || xtag || "[" || i || "] := " ||
  78.           ximage(x[i],indent,done)
  79.         }
  80.      s := image(x)
  81.      s[-1:-1] := "," || \t
  82.      xtag || " := " || s || ss
  83.      }
  84.       #
  85.       #  Set.
  86.       #
  87.       "set": {
  88.      done[x] := xtag := "S" || (tag +:= 1)
  89.      every i := !sort(x) do {
  90.         ss ||:= indent || "insert(" || xtag || "," ||
  91.           ximage(i,indent,done,) || ")"
  92.         }
  93.      xtag || " := " || "set()" || ss
  94.      }
  95.       #
  96.       #  Table.
  97.       #
  98.       "table": {
  99.      done[x] := xtag := "T" || (tag +:= 1)
  100.      #
  101.      #  Output the table elements.  This is a bit tricky, since
  102.      #  the subscripts might be structured, too.
  103.      #
  104.      every i := !sort(x) do {
  105.         t := ximage(i[1],indent || "   ",done)
  106.         if t ? (not any('\'"') & s := tab(find(" :="))) then
  107.           t := "{" || t || indent || "   " || s || "}"
  108.         ss ||:= indent || xtag || "[" ||
  109.           t || "] := " ||
  110.           ximage(i[2],indent,done)
  111.         }
  112.      #
  113.      #  Output the table, including its default value (which might
  114.      #  also be structured.
  115.      #
  116.      t := ximage(x[[]],indent || "   ",done)
  117.      if t ? (not any('\'"') & s := tab(find(" :="))) then
  118.            t := "{" || t || indent || "   " || s || "}"
  119.      xtag || " := " || "table(" || t || ")" || ss
  120.      }
  121.       #
  122.       #  Record.
  123.       #
  124.       default: {
  125.      done[x] := xtag := "R" || (tag +:= 1)
  126.      every i := 1 to *x do {
  127.         ss ||:= indent || xtag || "[" || i || "] := " ||
  128.           ximage(\x[i],indent,done)
  129.         }
  130.      xtag || " := " || t || "()" || ss
  131.      }
  132.       }
  133.    #
  134.    #  If this is the outer invocation, clean up before returning.
  135.    #
  136.    if /state then {
  137.       &trace := tr                        # restore &trace
  138.       }
  139.    #
  140.    #  Return the result.
  141.    #
  142.    return s
  143. end
  144.